home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2006 May / PCpro_2006_05.ISO / files / mobile / fma-2.0-stable-setup.exe / {app} / source / uObex.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2005-01-26  |  43.9 KB  |  1,568 lines
  1. unit uObex;
  2.  
  3. {
  4. *******************************************************************************
  5. * Descriptions: OBEX Implementation
  6. * $Source: /cvsroot/fma/fma/uObex.pas,v $
  7. * $Locker:  $
  8. *
  9. * Todo:
  10. *    - see code comments "todo:"
  11. *
  12. * Change Log:
  13. * $Log: uObex.pas,v $
  14. * Revision 1.30.6.2  2005/01/25 16:03:19  z_stoichev
  15. * Merged with 2.1 Beta 1 bugfixes
  16. *
  17. * Revision 1.30.6.1  2004/12/19 17:27:43  lordlarry
  18. * Fixed Typo's
  19. *
  20. * Revision 1.30  2004/07/14 10:03:41  z_stoichev
  21. * - Added Obex error 'Object is in use' handled.
  22. * - Added Obex CPU 100% usage workarounds.
  23. *
  24. * Revision 1.29  2004/05/19 18:34:16  z_stoichev
  25. * Build 0.1.0.35c
  26. *
  27. * Revision 1.28  2004/03/30 16:43:47  z_stoichev
  28. * SyncML support
  29. * Bugfixes
  30. *
  31. * Revision 1.27  2004/03/12 14:41:00  z_stoichev
  32. * Get/PutObject friendly name
  33. *
  34. * Revision 1.26  2004/01/27 15:55:10  z_stoichev
  35. * Activity log messages cleanups.
  36. *
  37. * Revision 1.25  2004/01/26 10:34:19  z_stoichev
  38. * Fixed Obex Abort method misused with SysUtils one.
  39. * Other fixes.
  40. *
  41. * Revision 1.24  2004/01/15 14:16:03  z_stoichev
  42. * Modified Obex in use process.
  43. *
  44. * Revision 1.23  2003/12/12 12:37:19  z_stoichev
  45. * Add delete file support.
  46. *
  47. * Revision 1.22  2003/12/11 13:14:54  z_stoichev
  48. * WaitASec moved into Unit1.
  49. *
  50. * Revision 1.21  2003/12/03 16:29:19  z_stoichev
  51. * Fixed error when connection interrupted while connecting.
  52. * Fixed Obex session aborting.
  53. * Loop check if application is terminated.
  54. *
  55. * Revision 1.20  2003/12/02 16:38:07  z_stoichev
  56. * Add LastErrorCode propertry.
  57. * Already in use issue changes.
  58. *
  59. * Revision 1.19  2003/12/01 15:58:15  z_stoichev
  60. * Anti-Freeze and Obex Already in use update.
  61. *
  62. * Revision 1.18  2003/11/28 09:38:07  z_stoichev
  63. * Merged with branch-release-1-1 (Fma 0.10.28c)
  64. *
  65. * Revision 1.17.2.10  2003/11/11 13:14:27  z_stoichev
  66. * Show progress only if Restored option support.
  67. *
  68. * Revision 1.17.2.9  2003/11/10 14:03:10  z_stoichev
  69. * RC3
  70. *
  71. * Revision 1.17.2.8  2003/10/31 14:56:45  z_stoichev
  72. * Ask for retry if Obex is already used by another app.
  73. *
  74. * Revision 1.17.2.7  2003/10/30 15:20:24  z_stoichev
  75. * Execute Obex command semafor usage.
  76. * Make Abort working, and add method IsAborted.
  77. *
  78. * Revision 1.17.2.6  2003/10/29 12:01:32  z_stoichev
  79. * Buffers clen up on connect/abort.
  80. *
  81. * Revision 1.17.2.5  2003/10/28 12:58:19  z_stoichev
  82. * Changed Abort handeling to avoid loops.
  83. *
  84. * Revision 1.17.2.4  2003/10/27 15:24:33  z_stoichev
  85. * Changed display messages.
  86. *
  87. * Revision 1.17.2.3  2003/10/27 13:17:27  z_stoichev
  88. * Show status messages after Get/Del operations.
  89. *
  90. * Revision 1.17.2.2  2003/10/27 09:50:55  z_stoichev
  91. * Prerelease bug-fixes.
  92. *
  93. * Revision 1.17.2.1  2003/10/27 07:22:54  z_stoichev
  94. * Build 0.1.0 RC1 Initial Checkin.
  95. *
  96. * Revision 1.17  2003/10/24 12:36:45  z_stoichev
  97. * T300 "Obex Forbidden" issue workaround fixed I hope.
  98. *
  99. * Revision 1.16  2003/10/22 13:21:13  z_stoichev
  100. * Make progress indicator optional.
  101. *
  102. * Revision 1.15  2003/10/21 15:33:25  z_stoichev
  103. * Bugfixes! Synchro was not working, it was too fast.
  104. *
  105. * Revision 1.14  2003/10/21 12:37:59  z_stoichev
  106. * Changed Get method result value to cardinal.
  107. *
  108. * Revision 1.13  2003/10/20 14:50:21  z_stoichev
  109. * More Obex headers are implemented.
  110. * Connection ID and Who Obex support and
  111. * additional checks on Connect.
  112. * Added Connection Forbidden error message.
  113. * CPU usage on transfer is reduced.
  114. * Obex Abort command is implemented.
  115. * Obex Header type support.
  116. *
  117. * Revision 1.12  2003/10/17 12:06:55  z_stoichev
  118. * Fixed leaveing open Obex session on connect error.
  119. * Todo: to process obex headers (skip unknown ones)
  120. *
  121. * Revision 1.11  2003/10/14 15:55:59  z_stoichev
  122. * Fixed is "sync aborted" issue when downloading
  123. * entire address book.
  124. *
  125. * Revision 1.10  2003/10/14 14:57:41  z_stoichev
  126. * Fix two-line output on progress window.
  127. *
  128. * Revision 1.9  2003/10/14 13:02:16  z_stoichev
  129. * Using new SonyEricsson progress bar
  130. * for file transfers.
  131. *
  132. * Revision 1.8  2003/10/13 15:19:54  z_stoichev
  133. * Fixed misused Abort local method instead of silent
  134. * exception call Abort.
  135. *
  136. * Revision 1.7  2003/10/13 14:14:45  z_stoichev
  137. * Recoded methods to avoid memory leaks.
  138. * Parameters are changed alot.
  139. * Addred support for progress dialog.
  140. *
  141. * Revision 1.6  2003/10/10 15:18:16  z_stoichev
  142. * Fixed memory leaks, plus optimize
  143. *
  144. * Revision 1.5  2003/02/14 13:13:14  crino77
  145. * Debugobex moved to public
  146. * PutObject
  147. *       - Added support for stream = nil to delete entries in phone :))
  148. * PutObject from Procedure to Function;
  149. * PutFile added Disconnect;
  150. *     Line added comment by //ADD
  151. *     Line removed comment by //OLD
  152. *
  153. * Revision 1.4  2003/01/30 04:15:57  warren00
  154. * Updated with header comments
  155. *
  156. *
  157. *******************************************************************************
  158. }
  159.  
  160. interface
  161.  
  162. uses Windows, Classes, Forms, Dialogs;
  163.  
  164. const
  165.   ObexNoSession = cardinal(-1);
  166.   ObexFolderBrowserServiceID: string[16] = #$F9#$EC#$7B#$C4#$95#$3C#$11#$D2#$98#$4E#$52#$54#$00#$DC#$9E#$09;
  167.   ObexSyncMLDataSyncXML: string          = 'application/vnd.syncml+xml';
  168.   ObexSyncMLDataSyncWirelessXML: string  = 'application/vnd.syncml+wbxml';
  169.   ObexSyncMLDevManXML: string            = 'application/vnd.syncml.dm+xml';
  170.   ObexSyncMLDevManWirelessXML: string    = 'application/vnd.syncml.dm+wbxml';
  171.  
  172. type
  173.   TObexItem = class(TObject)
  174.   private
  175.   protected
  176.     FPacketData: String;
  177.     procedure SetRaw(buffer: String); virtual;
  178.     function GetRaw: String; virtual;
  179.     function GetPacketData: String; virtual;
  180.     procedure SetPacketData(const Value: String); virtual;
  181.     function GetPacketLen: Integer; virtual;
  182.   public
  183.     PacketID: Byte;
  184.     property PacketLen: Integer read GetPacketLen;
  185.     property PacketData: String read GetPacketData write SetPacketData;
  186.     property Raw: String read GetRaw write SetRaw;
  187.     constructor Create(HID: byte = 0; data: String='');
  188.   end;
  189.  
  190.   // TODO: Add TObexWideStrSeq
  191.   TObexName = class(TObexItem)
  192.   protected
  193.     procedure SetRaw(buffer: String); override;
  194.     function GetRaw: String; override;
  195.   public
  196.     name: WideString;
  197.     constructor Create(nameStr: WideString='');
  198.   end;
  199.  
  200.   TObexDescription = class(TObexName)
  201.   public
  202.     constructor Create(descrStr: WideString='');
  203.     property descr: WideString read name write name;
  204.   end;
  205.  
  206.   TObexByteSeq = class(TObexItem)
  207.   protected
  208.     seqbuffer: String;
  209.     procedure SetRaw(buffer: String); override;
  210.     function GetRaw: String; override;
  211.   public
  212.     constructor Create(HID: byte; byteseq: String='');
  213.   end;
  214.  
  215.   TObexTarget = class(TObexByteSeq)
  216.   public
  217.     constructor Create(targetStr: String='');
  218.     property Target: String read seqbuffer write seqbuffer;
  219.   end;
  220.  
  221.   TObexWho = class(TObexByteSeq)
  222.   public
  223.     constructor Create(whoStr: String='');
  224.     property Who: string read seqbuffer write seqbuffer;
  225.   end;
  226.  
  227.   TObexType = class(TObexByteSeq)
  228.   public
  229.     constructor Create(typeStr: String='');
  230.     property MimeType: string read seqbuffer write seqbuffer;
  231.   end;
  232.  
  233.   // TODO: Add TObexCardinal
  234.   TObexLength = class(TObexItem)
  235.   protected
  236.     procedure SetRaw(buffer: String); override;
  237.     function GetRaw: String; override;
  238.   public
  239.     size: Cardinal;
  240.     constructor Create(s: Cardinal=0);
  241.   end;
  242.  
  243.   TObexConnection = class(TObexLength)
  244.   public
  245.     constructor Create(cid: Cardinal=0);
  246.     property ConnectionID: cardinal read size write size;
  247.   end;
  248.  
  249.   TObexItemList = class(TList)
  250.   protected
  251.     function  GetObexItem(Index: integer): TObexItem;
  252.     procedure PutObexItem(Index: integer; ObexItem: TObexItem);
  253.   public
  254.     property Items[Index: integer]: TObexItem read GetObexItem write PutObexItem;
  255.     destructor Destroy; override;
  256.     procedure FreeAll;
  257.   end;
  258.  
  259.   TObexPacket = class(TObexItem)
  260.   private
  261.     function GetBody: TObexItem;
  262.   protected
  263.     function GetPacketData: String; override;
  264.     procedure SetPacketData(const Value: String); override;
  265.     function GetConnectionID: cardinal;
  266.     function GetLength: integer;
  267.     function GetWho: string;
  268.   public
  269.     Child: TObexItemList;
  270.     property Body: TObexItem read GetBody;
  271.     constructor Create(HID: byte = 0; data: String='');
  272.     destructor Destroy; override;
  273.   end;
  274.  
  275.   TObexSetPath = class(TObexPacket)
  276.   protected
  277.     procedure SetRaw(buffer: String); override;
  278.     function GetRaw: String; override;
  279.     function GetPacketLen: Integer; override;
  280.   public
  281.     Flags,Constants: Byte;
  282.     constructor Create(path: String=''; GoUpFirst: boolean = False; DontCreateDir: boolean = True);
  283.   end;
  284.  
  285.   TObexConnectPacket = class(TObexItem)
  286.   protected
  287.     procedure SetRaw(buffer: String); override;
  288.     function GetRaw: String; override;
  289.   public
  290.     // TODO: Add session id support
  291.     ObexVersion: Integer;
  292.     Flag: byte;
  293.     MaxPacketLen: Integer;
  294.     Target: String;
  295.     constructor Create(HID: byte=0; MaxLen: Integer=0; TargetStr: String='');
  296.   end;
  297.  
  298.   TObexTargetType = (ocOther, ocSyncML, ocIrmcSync, ocFolderBrowseing);
  299.  
  300.   TObex = class(TObject)
  301.   private
  302.     FAbort: Boolean;
  303.     FLastReceivedPacket: String;
  304.     packetLen: Integer;
  305.     FRxBuffer: String;
  306.     FPacketsize: Integer;
  307.     ConnID: cardinal;
  308.     RcPackets: TStringList;
  309.     function CheckForPacket: boolean;
  310.     procedure GetReceivedObject(var obj: TObexPacket);
  311.     procedure SentObject(obexItem: TObexItem); overload;
  312.     procedure SentObject(HID: byte = 0; data: String=''); overload;
  313.     procedure DoAbort;
  314.     procedure ClearRxBuffers;
  315.   protected
  316.     FLastErrorCode: integer;
  317.     FIsAborted,SendingData: boolean;
  318.     TargetType: TObexTargetType;
  319.   public
  320.     Connected: Boolean;
  321.     MaxPacketSize: Integer;
  322.     debugobex: Boolean;
  323.     constructor Create;
  324.     destructor Destroy; override;
  325.     { For incomming data }
  326.     procedure OnRxChar(c: char);
  327.     { Connection }
  328.     procedure Connect(Target: String='');
  329.     procedure Disconnect;
  330.     { Schedule abort operation }
  331.     function IsAborted: boolean;
  332.     procedure Abort;
  333.     { Dangerous! Do not you if you don't know what are you doing! }
  334.     procedure ForceAbort;
  335.     { Empty dir changes to root folder }
  336.     function ChangeDir(name: WideString): boolean;
  337.     { List folder contents }
  338.     function List(var Xml: TStringStream): cardinal;
  339.     { Returns current LUID of the object if any. If the stream parameter
  340.       is nil, the object will be deleted. }
  341.     function PutObject(name: WideString; stream: TStream; progress: boolean = False;
  342.       FriendlyName: string = ''): WideString;
  343.     { Returns object size in bytes or 0 on failure. }
  344.     function GetObject(path: WideString; var where: TMemoryStream; progress: boolean = False;
  345.       FriendlyName: string = ''): cardinal;
  346.     { Direct calss }
  347.     procedure PutFile(filename: WideString; Delete: boolean = False);
  348.     procedure GetFile(filename: WideString; objname: WideString = ''; Silent: boolean = False);
  349.   published
  350.     property LastErrorCode: integer read FLastErrorCode;  
  351.   end;
  352.  
  353. const
  354.   FMaxLuidLen: cardinal = 12;
  355.  
  356. function bytestream2hex(byteStream: String; seperator: String=' '): String;
  357.  
  358. implementation
  359.  
  360. uses Unit1, SysUtils, Math, uConnProgress;
  361.  
  362. { TObex }
  363.  
  364. procedure TObex.Abort;
  365. begin
  366.   FAbort := True;
  367. end;
  368.  
  369. function TObex.ChangeDir(name: WideString): boolean;
  370. var
  371.   thisPacket: TObexSetPath;
  372.   received: TObexPacket;
  373.   wasconn: boolean;
  374. begin
  375.   Result := False;
  376.   wasconn := Connected;
  377.   if not Connected then Connect; // Start OBEX Mode if it's nessesery
  378.   try
  379.     Form1.Debug('Obex folder going into: /' + name);
  380.  
  381.     thisPacket := TObexSetPath.Create(name);
  382.     try
  383.       SentObject(thisPacket);
  384.     finally
  385.       thisPacket.Destroy;
  386.     end;
  387.  
  388.     received := TObexPacket.Create;
  389.     try
  390.       GetReceivedObject(received);
  391.  
  392.       if received.PacketID <> $A0 then
  393.         raise Exception.Create('Invalid Respond ' + bytestream2hex(received.Raw));
  394.  
  395.       Form1.Debug('Obex folder changed to: /' + name);
  396.       Result := True;
  397.     finally
  398.       received.Free;
  399.     end;
  400.   finally
  401.     { Stop our connections only }
  402.     if not wasconn then Disconnect;
  403.   end;
  404. end;
  405.  
  406. function TObex.CheckForPacket: boolean;
  407. var
  408.   s: string;
  409. begin
  410.   //Form1.VaCommRxChar(nil,0);
  411.   if RcPackets.Count <> 0 then begin
  412.     s := RcPackets[0];
  413.     RcPackets.Delete(0);
  414.     if debugobex then Form1.Debug('[RX] ' + bytestream2hex(s));
  415.     FLastReceivedPacket := s;
  416.     SendingData := False;
  417.     Result := True;
  418.   end
  419.   else
  420.     Result := False;
  421. end;
  422.  
  423. procedure TObex.Connect(Target: String);
  424. var
  425.   recpackt: TObexPacket;
  426.   sent,received: TObexConnectPacket;
  427.   whoreply: string;
  428. begin
  429.   if Connected then exit;
  430.   repeat
  431.     Form1.TxAndWait('AT*EOBEX', 'CONNECT');
  432.     if Form1.FAlreadyInUseObex then begin
  433.       case MessageDlg('OBEX session can not be established at this time, because '+
  434.         'the service is busy!'#13#13+
  435.         'Close any other Obex applications (maybe running in background), '+
  436.         'or turn off and then back on your phone connection (disable then '+
  437.         'enable Bluetooth, unplug then plug cable etc). Or check if you have '+
  438.         'to answer on some connection question (contirmation) in your phone. '+
  439.         'If nothing above helps restart your phone and try again.'#13#13+
  440.         'Do you wish to try again or Cancel current operation?',
  441.         mtConfirmation,[mbYes,mbNo,mbCancel],0) of
  442.         ID_YES: WaitASec;
  443.         ID_NO: begin
  444.           Form1.Status('Obex already in use');
  445.           raise Exception.Create('Obex Connect: Already in use or Connect failed');
  446.         end;
  447.         ID_CANCEL: begin
  448.           Form1.Status('Obex already in use, Aborting...');
  449.           Form1.ActionConnectionAbort.Execute;
  450.           SysUtils.Abort;
  451.         end;
  452.       end;
  453.     end
  454.     else break;
  455.   until False;
  456.   try
  457.     FIsAborted := False;
  458.     FAbort := False;
  459.     SendingData := False;
  460.     Connected := True;
  461.     Form1.Debug('Obex Session Established');
  462.     WaitASec;
  463.     if not Connected or FIsAborted then SysUtils.Abort;
  464.     Form1.Debug('Obex Negotiateing...');
  465.     sent := TObexConnectPacket.Create($80, MaxPacketSize, Target);
  466.     try
  467.       ClearRxBuffers;
  468.       SentObject(sent);
  469.       received := TObexConnectPacket.Create;
  470.       recpackt := TObexPacket.Create;
  471.       try
  472.         if FLastReceivedPacket = '' then SysUtils.Abort;
  473.         if ord(FLastReceivedPacket[1]) = $C3 then
  474.           raise Exception.Create('Obex: Access to this target is denied');
  475.         if ord(FLastReceivedPacket[1]) <> $A0 then
  476.           raise Exception.Create('Invalid Respond ' + bytestream2hex(FLastReceivedPacket));
  477.  
  478.         // get packet size
  479.         received.Raw := FLastReceivedPacket;
  480.         FPacketsize := min(MaxPacketSize, received.MaxPacketLen);
  481.         Form1.Debug('Obex Negotiated: Packet Size = ' + IntToStr(FPacketsize));
  482.         // TODO: Add support for Obex timeout...
  483.         // process optional headers, remove connect data (6 bytes + opcode)
  484.         Delete(FLastReceivedPacket,1,7);
  485.         recpackt.PacketData := FLastReceivedPacket;
  486.         // get who reply (should be target)
  487.         whoreply := recpackt.GetWho;
  488.         if whoreply <> Target then
  489.           raise Exception.Create('Wrong Who Received: ' + whoreply)
  490.         else
  491.           TargetType := ocOther;
  492.           if whoreply <> '' then begin
  493.             if CompareMem(@whoreply[1],@ObexFolderBrowserServiceID[1],length(whoreply)) then begin
  494.               whoreply := 'Folder Browsing';
  495.               TargetType := ocFolderBrowseing;
  496.             end;
  497.             if AnsiCompareText(whoreply,'IRMC-SYNC') = 0 then
  498.               TargetType := ocIrmcSync;
  499.             if AnsiCompareText(whoreply,'SYNCML-SYNC') = 0 then
  500.               TargetType := ocSyncML;
  501.             Form1.Debug('Obex Negotiated: Application = ' + whoreply);
  502.           end;
  503.         // get connection id
  504.         ConnID := recpackt.GetConnectionID;
  505.         if ConnID <> ObexNoSession then
  506.           Form1.Debug('Obex Negotiated: Connection = ' + IntToStr(ConnID));
  507.       finally
  508.         received.Free;
  509.         recpackt.Free;
  510.       end;
  511.     finally
  512.       sent.Free;
  513.     end;
  514.   except
  515.     Disconnect;
  516.     raise;
  517.   end;
  518. end;
  519.  
  520. constructor TObex.Create;
  521. begin
  522.   RcPackets := TStringList.Create;
  523.   MaxPacketSize := $0100;
  524.   Connected := False;
  525.   ConnID := ObexNoSession;
  526. end;
  527.  
  528. destructor TObex.Destroy;
  529. begin
  530.   if Connected then Disconnect;
  531.   RcPackets.Free;
  532.   inherited;
  533. end;
  534.  
  535. procedure TObex.Disconnect;
  536. var
  537.   received: TObexPacket;
  538. begin
  539.   if not Connected then exit;
  540.   SentObject($81); // Disconnecte
  541.  
  542.   received := TObexPacket.Create;
  543.   try
  544.     GetReceivedObject(received);
  545.  
  546.     if received.PacketID <> $A0 then // expect 'Sucess'
  547.       raise Exception.Create('Invalid Respond: ' + bytestream2hex(received.Raw));
  548.  
  549.     ConnID := ObexNoSession;  
  550.     Connected := False;
  551.     Form1.Debug('Obex Session Ended');
  552.   finally
  553.     received.Free;
  554.   end;
  555. end;
  556.  
  557. procedure TObex.DoAbort;
  558. begin
  559.   if Connected and not FIsAborted then begin
  560.     ForceAbort;
  561.     { Do not cancel connection attemt }
  562.     if Form1.CoolTrayIcon1.CycleIcons then Form1.FAbortDetected := False;
  563.   end;
  564. end;
  565.  
  566. function TObex.GetObject(path: WideString; var where: TMemoryStream; progress: boolean; FriendlyName: string): cardinal;
  567. var
  568.   received, thisPacket: TObexPacket;
  569.   rsize,bsize,sofar: Integer;
  570.   buffer,stat,what: string;
  571.   frmConnect: TfrmConnect;
  572.   wasconn: boolean;
  573. begin
  574.   Result := 0;
  575.   frmConnect := nil;
  576.   FIsAborted := False;
  577.   wasconn := Connected;
  578.   if not Connected then Connect; // Start OBEX Mode if it's nessesery
  579.   try
  580.     Form1.Status('Receiving ' + path);
  581.     
  582.     try
  583.       thisPacket := TObexPacket.Create($83);
  584.       try
  585.         if TargetType = ocSyncML then
  586.           thisPacket.Child.Add(TObexType.Create(ObexSyncMLDataSyncXML));
  587.  
  588.         thisPacket.Child.Add(TObexName.Create(path));
  589.  
  590.         SentObject(thisPacket);
  591.       finally
  592.         thisPacket.Destroy;
  593.       end;
  594.  
  595.       if FriendlyName <> '' then what := FriendlyName
  596.         else what := path;
  597.  
  598.       { Show progress window }
  599.       if progress and Form1.CanShowProgress then begin
  600.         frmConnect := GetProgressDialog;
  601.         frmConnect.SetDescr('Retrieving ' + what);
  602.         frmConnect.ShowProgress(Form1.FProgressLongOnly);
  603.       end;
  604.  
  605.       rsize := -2; // set here -3 to prevent size check/detection
  606.       sofar := 0;
  607.       received := TObexPacket.Create;
  608.       try
  609.         repeat
  610.           try
  611.             GetReceivedObject(received);
  612.             { check for length header on first packet only }
  613.             if (rsize = -2) and Assigned(frmConnect) then begin
  614.               rsize := received.GetLength;
  615.               if rsize > 0 then frmConnect.Initialize(rsize);
  616.             end;
  617.             if FIsAborted then break;
  618.             buffer := received.Body.PacketData;
  619.             bsize := length(buffer);
  620.             sofar := sofar + bsize;
  621.             where.WriteBuffer(buffer[1],bsize);
  622.             if (rsize > 0) and Assigned(frmConnect) then
  623.               frmConnect.IncProgress(bsize);
  624.  
  625.             //Form1.Debug('Packet Sucessfull. Get=' + IntToStr(bsize));
  626.  
  627.             if progress then begin
  628.               {
  629.               if rsize > 0 then
  630.                 stat := Format('Receiving %s (%d of %d bytes)',[path,sofar,rsize])
  631.               else
  632.                 stat := Format('Receiving %s (%d bytes so far)',[path,sofar]);
  633.               Form1.Status(stat);
  634.               }
  635.               if Assigned(frmConnect) then begin
  636.                 if rsize > 0 then
  637.                   stat := Format('Receiving %s'#13#10'(%.1n of %.1n kB)',[what,sofar / 1024,rsize / 1024])
  638.                 else
  639.                   stat := Format('Receiving %s'#13#10'(%.1n kB so far)',[what,sofar / 1024]);
  640.                 frmConnect.SetDescr(stat);
  641.               end;
  642.             end;
  643.  
  644.             if FIsAborted or (received.PacketID <> $90) then break; // expect continue?
  645.  
  646.             thisPacket := TObexPacket.Create($83);
  647.             try
  648.               if TargetType = ocSyncML then
  649.                 thisPacket.Child.Add(TObexType.Create(ObexSyncMLDataSyncXML));
  650.               SentObject(thisPacket);
  651.             finally
  652.               thisPacket.Destroy;
  653.             end;
  654.           except
  655.             { we should abort miltipart operations }
  656.             DoAbort;
  657.             raise;
  658.           end;
  659.         until not Connected or FIsAborted;
  660.       finally
  661.         received.Free;
  662.       end;
  663.  
  664.       if rsize > 0 then
  665.         Form1.Status('Received ' + path + ' (' + IntToStr(rsize) + ' bytes)')
  666.       else
  667.         Form1.Status('Received ' + path);
  668.         
  669.       Result := where.size;
  670.       where.Seek(0, soFromBeginning);
  671.     except
  672.       on E: Exception do begin
  673.         Form1.Status('Error retrieving ' + path + ': ' + E.Message);
  674.         if FIsAborted then begin
  675.           Form1.Status('Operation aborted by user');
  676.           raise;
  677.         end
  678.         else
  679.           raise Exception.Create('Obex Get Failed: ' + E.Message);
  680.       end;
  681.     end;
  682.   finally
  683.     { Stop our connections only }
  684.     if not wasconn then Disconnect;
  685.     if Assigned(frmConnect) then FreeProgressDialog;
  686.   end;
  687. end;
  688.  
  689. procedure TObex.GetReceivedObject(var obj: TObexPacket);
  690. begin
  691.   obj.Raw := FLastReceivedPacket;
  692.   try
  693.     case obj.PacketID of
  694.       $C0: raise Exception.Create('Bad request');
  695.       $C1: raise Exception.Create('Unauthorized');
  696.       $C2: raise Exception.Create('Payment required');
  697.       $C3: raise Exception.Create('Forbidden');
  698.       $C4: raise Exception.Create('Not found');
  699.       $C5: raise Exception.Create('Method not allowed');
  700.       $C6: raise Exception.Create('Not Acceptable');
  701.       $C7: raise Exception.Create('Proxy Authentication required');
  702.       $C8: raise Exception.Create('Request Time Out');
  703.       $C9: raise Exception.Create('Conflict');
  704.       $CA: raise Exception.Create('Gone');
  705.       $CB: raise Exception.Create('Length Required');
  706.       $CC: raise Exception.Create('Precondition failed');
  707.       $CD: raise Exception.Create('Requested entity too large');
  708.       $CE: raise Exception.Create('Requested URL too large');
  709.       $CF: raise Exception.Create('Unsupported media type');
  710.       $D0: raise Exception.Create('Internal Server Error');
  711.       $D1: raise Exception.Create('Not Implemented');
  712.       $D2: raise Exception.Create('Bad Gateway');
  713.       $D3: raise Exception.Create('Service Unavailable');
  714.       $D4: raise Exception.Create('Gateway Timeout');
  715.       $D5: raise Exception.Create('HTTP version not supported');
  716.       $E1: raise Exception.Create('Object is in use'); // Database locked
  717.     end;
  718.   except
  719.     SendingData := False;
  720.     FLastErrorCode := obj.PacketID;
  721.     raise;
  722.   end;
  723. end;
  724.  
  725. function TObex.List(var Xml: TStringStream): cardinal;
  726. var
  727.   thisPacket,received: TObexPacket;
  728.   wasconn: boolean;
  729. begin
  730.   Result := 0;
  731.   Xml.Size := 0;
  732.   FIsAborted := False;
  733.   wasconn := Connected;
  734.   if not Connected then Connect; // Start OBEX Mode if it's nessesery
  735.   try
  736.     thisPacket := TObexPacket.Create($83);
  737.     try
  738.       thisPacket.Child.Add(TObexItem.Create($42,'x-obex/folder-listing'#00));
  739.       SentObject(thisPacket);
  740.     finally
  741.       thisPacket.Destroy;
  742.     end;
  743.     try
  744.       received := TObexPacket.Create;
  745.       try
  746.         repeat
  747.           try
  748.             GetReceivedObject(received);
  749.             try
  750.               Xml.WriteString(received.Body.PacketData);
  751.             except
  752.             end;  
  753.             if FIsAborted or (received.PacketID <> $90) then break;
  754.             SentObject($83);
  755.           except
  756.             { we should abort miltipart operations }
  757.             DoAbort;
  758.             raise;
  759.           end;
  760.         until not Connected or FIsAborted;
  761.  
  762.         Form1.Debug('Obex folder list complete');
  763.       finally
  764.         received.Free;
  765.       end;
  766.  
  767.       Result := length(Xml.DataString);
  768.       Xml.Seek(0, soFromBeginning);
  769.     except
  770.       on E: Exception do begin
  771.         Form1.Status('Error listing folder: ' + E.Message);
  772.         if FIsAborted then begin
  773.           Form1.Status('Operation aborted by user');
  774.           raise;
  775.         end
  776.         else
  777.           raise Exception.Create('Obex List Failed: ' + E.Message);
  778.       end;
  779.     end;
  780.   finally
  781.     { Stop our connections only }
  782.     if not wasconn then Disconnect;
  783.   end;
  784. end;
  785.  
  786. procedure TObex.OnRxChar(c: char);
  787. begin
  788.   FRxBuffer := FRxBuffer + c;
  789.  
  790.   if length(FRxBuffer) < 3 then
  791.     packetLen := -1
  792.   else
  793.     if (packetLen = -1) and (length(FRxBuffer) > 2) then
  794.       packetLen := (byte(FRxBuffer[2]) shl 8) or byte(FRxBuffer[3]);
  795.  
  796.   if length(FRxBuffer) = packetlen then begin
  797.     RcPackets.Add(FRxBuffer);
  798.     FRxBuffer := '';
  799.     packetlen := -1;
  800.   end;
  801. end;
  802.  
  803. procedure TObex.PutFile(filename: WideString; Delete: boolean);
  804. var
  805.   stream: TFileStream;
  806.   objname: WideString;
  807.   Dir: WideString;
  808.   i: integer;
  809. begin
  810.   objname := ExtractFileName(filename); // damm no unicode support
  811.   if Delete then begin
  812.     ChangeDir('');
  813.     repeat
  814.       i := Pos('/',objname);
  815.       if i = 0 then break;
  816.       Dir := Copy(objname,1,i-1);
  817.       StringReplace(Dir, #13#10, #10, [rfReplaceAll]);
  818.       System.Delete(objname,1,i);
  819.       ChangeDir(Dir);
  820.     until False;
  821.     PutObject(objname, nil);
  822.   end
  823.   else begin
  824.     { Phone will decide where to put the new file }
  825.     stream := TFileStream.Create(filename, fmOpenRead or fmShareDenyNone);
  826.     try
  827.       PutObject(objname, stream, true);
  828.     finally
  829.       stream.Free;
  830.     end;
  831.   end;
  832. end;
  833.  
  834. procedure TObex.GetFile(filename,objname: WideString; Silent: boolean);
  835. var
  836.   str: TMemoryStream;
  837.   stream: TFileStream;
  838.   Dir: WideString;
  839.   i: integer;
  840. begin
  841.   if objname = '' then objname := ExtractFileName(filename);
  842.   ChangeDir('');
  843.   repeat
  844.     i := Pos('/',objname);
  845.     if i = 0 then break;
  846.     Dir := Copy(objname,1,i-1);
  847.     StringReplace(Dir, #13#10, #10, [rfReplaceAll]);
  848.     Delete(objname,1,i);
  849.     ChangeDir(Dir);
  850.   until False;
  851.   str := TMemoryStream.Create;
  852.   try
  853.     GetObject(objname, str, not Silent);
  854.     { Create file only on success }
  855.     stream := TFileStream.Create(filename, fmCreate);
  856.     try
  857.       stream.CopyFrom(str,str.Size)
  858.     finally
  859.       stream.Free;
  860.     end;
  861.   finally
  862.     str.Free;
  863.   end;
  864. end;
  865.  
  866. function TObex.PutObject(name: WideString; stream: TStream; progress: boolean; FriendlyName: string): WideString;
  867. var
  868.   received, thisPacket: TObexPacket;
  869.   emptySlot: Integer;
  870.   buffer,stat,what: String;
  871.   wasconn: boolean;
  872.   frmConnect: TfrmConnect;
  873. begin
  874.   Result := '';
  875.   frmConnect := nil;
  876.   FIsAborted := False;
  877.   wasconn := Connected;
  878.   if not Connected then Connect; // Start OBEX Mode if it's nessesery
  879.   try
  880.     { nil means put null packet and delete the entries }
  881.     if stream = nil then begin
  882.        Form1.Status('Deleting ' + name);
  883.  
  884.        thisPacket := TObexPacket.Create($82); // final put
  885.        try
  886.          thisPacket.Child.Add(TObexName.Create(name));
  887.          SentObject(thisPacket);
  888.        finally
  889.          thisPacket.Destroy;
  890.        end;
  891.  
  892.        received := TObexPacket.Create;
  893.        try
  894.          GetReceivedObject(received);
  895.  
  896.          if received.PacketID <> $A0 then // expect 'continue'
  897.            raise Exception.Create('Invalid Respond ' + bytestream2hex(received.Raw));
  898.  
  899.          //For Sync i need only the last row (LUID) :)
  900.          if received.Body <> nil then Result := Copy(received.Body.PacketData,3,FMaxLuidLen);
  901.        finally
  902.          received.Free;
  903.        end;
  904.        Form1.Status('Deleted ' + name);
  905.        { Now exit }
  906.        exit;
  907.     end;
  908.  
  909.     { Show progress window }
  910.     if progress and Form1.CanShowProgress then begin
  911.       frmConnect := GetProgressDialog;
  912.       frmConnect.Initialize(stream.Size,'Check your phone for instructions...');
  913.       frmConnect.ShowProgress(Form1.FProgressLongOnly);
  914.     end;
  915.  
  916.     Form1.Status('Sending ' + name + ' (' + IntToStr(stream.Size) + ' bytes)');
  917.  
  918.     if FriendlyName <> '' then what := FriendlyName
  919.       else what := name;
  920.  
  921.     try
  922.       stream.Seek(0, soFromBeginning);
  923.  
  924.       // put request
  925.       while Connected and (stream.Position < stream.Size) and (not FIsAborted) do
  926.       try
  927.         thisPacket := TObexPacket.Create($02);
  928.         try
  929.           if TargetType = ocSyncML then
  930.             thisPacket.Child.Add(TObexType.Create(ObexSyncMLDataSyncXML));
  931.  
  932.           // add name for first packet
  933.           if stream.Position = 0 then begin
  934.             thisPacket.Child.Add(TObexName.Create(name));
  935.             thisPacket.Child.Add(TObexLength.Create(stream.Size));
  936.           end;
  937.  
  938.           emptySlot := FPacketsize - thisPacket.PacketLen - 3;
  939.  
  940.           SetLength(buffer, emptySlot);
  941.           SetLength(buffer, stream.Read(buffer[1], emptySlot));
  942.  
  943.           thisPacket.Child.Add(TObexItem.Create($48, buffer));
  944.           SentObject(thisPacket);
  945.         finally
  946.           thisPacket.Destroy;
  947.         end;
  948.  
  949.         if Assigned(frmConnect) then frmConnect.IncProgress(emptySlot);
  950.  
  951.         received := TObexPacket.Create;
  952.         try
  953.           GetReceivedObject(received);
  954.           if FIsAborted then break;
  955.  
  956.           if received.PacketID <> $90 then // expect 'continue'
  957.             raise Exception.Create('Invalid Respond ' + bytestream2hex(received.Raw));
  958.  
  959.           if progress then begin
  960.             {
  961.             stat := Format('Sending %s (%d of %d bytes)',[name,stream.Position,stream.Size]);
  962.             Form1.Status(stat);
  963.             }
  964.             if Assigned(frmConnect) then begin
  965.               stat := Format('Sending %s'#13#10'(%.1n of %.1n kB)',[what,stream.Position / 1024,stream.Size / 1024]);
  966.               frmConnect.SetDescr(stat);
  967.             end;
  968.           end;  
  969.         finally
  970.           received.Free;
  971.         end;
  972.       except
  973.         { we should abort miltipart operations }
  974.         DoAbort;
  975.         raise;
  976.       end;
  977.  
  978.       { bookmarks and etc. ask user to keep file _after_ file transfer }
  979.       if Assigned(frmConnect) then frmConnect.SetDescr('Check your phone for instructions...');
  980.  
  981.       thisPacket := TObexPacket.Create($82); // final put
  982.       try
  983.         if TargetType = ocSyncML then
  984.           thisPacket.Child.Add(TObexType.Create(ObexSyncMLDataSyncXML));
  985.  
  986.         thisPacket.Child.Add(TObexItem.Create($49));
  987.  
  988.         SentObject(thisPacket);
  989.       finally
  990.         thisPacket.Destroy;
  991.       end;
  992.  
  993.       received := TObexPacket.Create;
  994.       try
  995.         GetReceivedObject(received);
  996.  
  997.         if received.PacketID <> $A0 then // expect 'continue'
  998.           raise Exception.Create('Invalid Respond ' + bytestream2hex(received.Raw));
  999.  
  1000.         //For Sync i need only the last row (LUID) :)
  1001.         if received.Body <> nil then Result := Copy(received.Body.PacketData,3,FMaxLuidLen);
  1002.  
  1003.         Form1.Status('Sent ' + name);
  1004.       finally
  1005.         received.Free;
  1006.       end;
  1007.     except
  1008.       on E: Exception do begin
  1009.         Form1.Status('Error sending ' + name + ': ' + E.Message);
  1010.         if FIsAborted then begin
  1011.           Form1.Status('Operation aborted by user');
  1012.           raise;
  1013.         end
  1014.         else
  1015.           raise Exception.Create('Obex Put Failed: ' + E.Message);
  1016.       end;
  1017.     end;
  1018.   finally
  1019.     { Stop our connections only }
  1020.     if not wasconn then Disconnect;
  1021.     if Assigned(frmConnect) then FreeProgressDialog;
  1022.   end;
  1023. end;
  1024.  
  1025. procedure TObex.SentObject(obexItem: TObexItem);
  1026. const
  1027.   Aborting: boolean = False;
  1028. var
  1029.   sid: TObexConnection;
  1030.   Raw: string;
  1031. begin
  1032.   FLastErrorCode := 0;
  1033.   FLastReceivedPacket := '';
  1034.  
  1035.   { It is illegal to send a Connection Id and a Target header in the same request. It is legal to send both
  1036.     headers in a response, as discussed in section 3.3.1.6. }
  1037.   if ConnID <> ObexNoSession then begin
  1038.     sid := TObexConnection.Create(ConnID);
  1039.     try
  1040.       // set conn id as a first header
  1041.       obexItem.PacketData := sid.Raw + obexItem.PacketData;
  1042.     finally
  1043.       sid.Free;
  1044.     end;
  1045.   end;
  1046.   Raw := obexItem.Raw;
  1047.  
  1048.   // TODO: Add semafor usafe here and WaitForSingleObject....
  1049.   while not IsAborted and SendingData do begin
  1050.     if CheckForPacket then break;
  1051.     Sleep(25);
  1052.     Application.ProcessMessages;
  1053.     if Application.Terminated then begin
  1054.       SendingData := False;
  1055.       SysUtils.Abort;
  1056.     end;  
  1057.   end;
  1058.  
  1059.   if debugobex then Form1.Debug('[TX] ' + bytestream2hex(Raw));
  1060.  
  1061.   SendingData := True;
  1062.  
  1063.   if Form1.FConnectionType = 2 then Form1.ComPort.WriteStr(Raw)
  1064.   else if Form1.FConnectionType = 1 then Form1.WIrSocket.SendStr(Raw)
  1065.   else Form1.WBtSocket.SendStr(Raw);
  1066.  
  1067.   while Connected and (FLastReceivedPacket = '') and (Aborting or not FAbort) do
  1068.     begin
  1069.       if CheckForPacket then break;
  1070.       Sleep(25);
  1071.       Application.ProcessMessages;
  1072.       if Form1.FAbort or Application.Terminated then begin
  1073.         Aborting := False;
  1074.         FAbort := True;
  1075.       end;
  1076.     end;
  1077.  
  1078.   if Connected and not Aborting and FAbort then begin
  1079.     Aborting := True;
  1080.     try
  1081.       FAbort := False;
  1082.       DoAbort;
  1083.     finally
  1084.       Aborting := False;
  1085.     end;
  1086.     Form1.Debug('Obex: Aborted by user');
  1087.     Form1.Status('Operation aborted by user');
  1088.     SysUtils.Abort;
  1089.   end;
  1090. end;
  1091.  
  1092. procedure TObex.SentObject(HID: byte; data: String);
  1093. var
  1094.   item: TObexItem;
  1095. begin
  1096.   item := TObexItem.Create(HID, data);
  1097.   try
  1098.     SentObject(item);
  1099.   finally
  1100.     item.free;
  1101.   end;
  1102. end;
  1103.  
  1104. procedure TObex.ClearRxBuffers;
  1105. begin
  1106.   FRxBuffer := '';
  1107.   RcPackets.Clear;
  1108. end;
  1109.  
  1110. procedure TObex.ForceAbort;
  1111. var
  1112.   tm: cardinal;
  1113. begin
  1114.   FIsAborted := True;
  1115.   // Should we remove this command complete wait loop.... ?
  1116.   tm := GetTickCount;
  1117.   while SendingData do begin
  1118.     if CheckForPacket then break;
  1119.     Sleep(25);
  1120.     Application.ProcessMessages;
  1121.     if Abs(GetTickCount - tm) > 10000 then SendingData := False;
  1122.   end;
  1123.   // Aborting...
  1124.   Form1.Debug('Obex: Aborting...');
  1125.   ClearRxBuffers;
  1126.   SentObject($FF);
  1127.   if (FLastReceivedPacket = '') or (ord(FLastReceivedPacket[1]) <> $A0) then
  1128.     Disconnect;
  1129.   // Set global abort flag
  1130.   Form1.FAbortDetected := True;  
  1131. end;
  1132.  
  1133. function TObex.IsAborted: boolean;
  1134. begin
  1135.   Result := FIsAborted;
  1136. end;
  1137.  
  1138. { TObexPacket }
  1139.  
  1140. constructor TObexItem.Create(HID: byte; data: String);
  1141. begin
  1142.   PacketID := HID;
  1143.   PacketData := data;
  1144. end;
  1145.  
  1146. function TObexItem.GetPacketData: String;
  1147. begin
  1148.   Result := FPacketData;
  1149. end;
  1150.  
  1151. function TObexItem.GetPacketLen: Integer;
  1152. begin
  1153.   Result := length(PacketData) + 3;
  1154. end;
  1155.  
  1156. function TObexItem.GetRaw: String;
  1157. var
  1158.   lenHigh, lenLow: Byte;
  1159. begin
  1160.   lenHigh := (PacketLen and $FF00) shr 8;
  1161.   lenLow := PacketLen and $00FF;
  1162.  
  1163.   Result := chr(packetID) + chr(lenHigh) + chr(lenLow) + PacketData;
  1164. end;
  1165.  
  1166. procedure TObexItem.SetPacketData(const Value: String);
  1167. begin
  1168.   FPacketData := Value;
  1169. end;
  1170.  
  1171. procedure TObexItem.SetRaw(buffer: String);
  1172. begin
  1173.   try
  1174.     packetID := byte(buffer[1]);
  1175.     //  packetLen := (byte(buffer[2]) shl 8) or byte(buffer[3]);
  1176.     PacketData := copy(buffer, 4, length(buffer) - 3);
  1177.   except
  1178.     packetID := 0;
  1179.     PacketData := '';
  1180.   end;
  1181. end;
  1182.  
  1183. { TPutRequestPacket }
  1184.  
  1185. constructor TObexConnectPacket.Create(HID: byte; MaxLen: Integer; TargetStr: String);
  1186. begin
  1187.   PacketID := HID;
  1188.   ObexVersion := $10;
  1189.   Flag := $00;
  1190.   MaxPacketLen := MaxLen;
  1191.   Target := TargetStr;
  1192. end;
  1193.  
  1194. function TObexConnectPacket.GetRaw: String;
  1195. var
  1196.   lenHigh, lenLow: Byte;
  1197.   obexTarget: TObexTarget;
  1198. begin
  1199.   lenHigh := (MaxPacketLen and $FF00) shr 8;
  1200.   lenLow := MaxPacketLen and $00FF;
  1201.   PacketData := chr(ObexVersion) + chr(Flag) + chr(lenHigh) + chr(lenLow);
  1202.  
  1203.   if Target <> '' then begin
  1204.     obexTarget := TObexTarget.Create(Target);
  1205.     try
  1206.       PacketData := PacketData + obexTarget.Raw;
  1207.     finally
  1208.       obexTarget.Free;
  1209.     end;
  1210.   end;
  1211.  
  1212.   Result := Inherited GetRaw;
  1213. end;
  1214.  
  1215. procedure TobexConnectPacket.SetRaw(buffer: String);
  1216. begin
  1217.   Inherited SetRaw(buffer);
  1218.  
  1219.   if length(PacketData) >= 4 then begin
  1220.     ObexVersion := byte(PacketData[1]);
  1221.     Flag := byte(PacketData[2]);
  1222.     MaxPacketLen := (byte(PacketData[3]) shl 8) or byte(PacketData[4]);
  1223.   end;
  1224. end;
  1225.  
  1226. { TObexPacket }
  1227.  
  1228. constructor TObexPacket.Create(HID: byte; data: String);
  1229. begin
  1230.   Child := TObexItemList.Create;
  1231.   inherited Create(HID, data);
  1232. end;
  1233.  
  1234. destructor TObexPacket.Destroy;
  1235. begin
  1236.   Child.Free;
  1237. end;
  1238.  
  1239. function TObexPacket.GetBody: TObexItem;
  1240. var
  1241.   i: Integer;
  1242. begin
  1243.   Result := nil;
  1244.  
  1245.   for i := 0 to Child.Count - 1 do begin
  1246.     if (Child.Items[i].PacketID = $48) or (Child.Items[i].PacketID = $49)
  1247.       or (Child.Items[i].PacketID = $4C) then begin
  1248.       Result := Child.Items[i];
  1249.     end;
  1250.   end;
  1251. end;
  1252.  
  1253. function TObexPacket.GetPacketData: String;
  1254. var
  1255.   i: Integer;
  1256. begin
  1257.   Result := '';
  1258.  
  1259.   for i := 0 to Child.Count - 1 do begin
  1260.     Result := Result + Child.Items[i].Raw;
  1261.   end;
  1262. end;
  1263.  
  1264. function TObexPacket.GetConnectionID: cardinal;
  1265. var
  1266.   i: integer;
  1267. begin
  1268.   Result := ObexNoSession;
  1269.   for i := 0 to Child.Count-1 do
  1270.     if Child.Items[i].ClassType = TObexConnection then begin
  1271.       Result := (Child.Items[i] as TObexConnection).ConnectionID;
  1272.       break;
  1273.     end;
  1274. end;
  1275.  
  1276. procedure TObexPacket.SetPacketData(const Value: String);
  1277. var
  1278.   buffer: String;
  1279.   itemlen: Integer;
  1280. //  item: String;
  1281.   obexitem: TObexItem;
  1282.   HT, HI: byte;
  1283. begin
  1284.   Child.FreeAll;
  1285.   buffer := Value;
  1286.   while buffer <> '' do begin
  1287.     itemlen := 0;
  1288.     HI := ord(buffer[1]);
  1289.     HT := (HI and $C0) shr 6;
  1290.     case HT of
  1291.       0: begin // null terminated Unicode text, length prefixed with 2 byte unsigned integer
  1292.            itemlen := (byte(buffer[2]) shl 8) or byte(buffer[3]);
  1293.          end;
  1294.       1: begin // byte sequence, length prefixed with 2 byte unsigned integer
  1295.            itemlen := (byte(buffer[2]) shl 8) or byte(buffer[3]);
  1296.          end;
  1297.       2: begin // 1 byte quantity
  1298.            itemlen := 2;
  1299.          end;
  1300.       3: begin // 4 byte quantity รป transmitted in network byte order (high byte first)
  1301.            itemlen := 5;
  1302.          end;
  1303.     end;
  1304.  
  1305.     // TODO: Add more header ID support here.
  1306.     case ord(buffer[1]) of
  1307.       $01: obexitem := TObexName.Create;
  1308.       $05: obexitem := TObexDescription.Create;
  1309.       $46: obexitem := TObexTarget.Create;
  1310.       $4A: obexitem := TObexWho.Create;
  1311.       $C3: obexitem := TObexLength.Create;
  1312.       $CB: obexitem := TObexConnection.Create;
  1313.     else
  1314.       obexItem := TObexItem.Create;
  1315.     end;
  1316.     try
  1317.       obexItem.Raw := copy(buffer, 1, itemlen);
  1318.       Child.Add(obexItem);
  1319.     except
  1320.       obexItem.Free;
  1321.       raise;
  1322.     end;
  1323.     Delete(buffer,1,itemlen);
  1324.   end;
  1325. end;
  1326.  
  1327. function TObexPacket.GetWho: string;
  1328. var
  1329.   i: integer;
  1330. begin
  1331.   Result := '';
  1332.   for i := 0 to Child.Count-1 do
  1333.     if Child.Items[i].ClassType = TObexWho then begin
  1334.       Result := (Child.Items[i] as TObexWho).Who;
  1335.       break;
  1336.     end;
  1337. end;
  1338.  
  1339. function TObexPacket.GetLength: integer;
  1340. var
  1341.   i: integer;
  1342. begin
  1343.   Result := -1;
  1344.   for i := 0 to Child.Count-1 do
  1345.     if Child.Items[i].ClassType = TObexLength then begin
  1346.       Result := (Child.Items[i] as TObexLength).size;
  1347.       break;
  1348.     end;
  1349. end;
  1350.  
  1351. { TObexName }
  1352.  
  1353. constructor TObexName.Create(nameStr: WideString);
  1354. begin
  1355.   inherited Create($01);
  1356.   name := nameStr;
  1357. end;
  1358.  
  1359. function TObexName.GetRaw: String;
  1360. var
  1361.   i, c: Integer;
  1362. begin
  1363.   PacketData := '';
  1364.   for i := 1 to length(name) do begin
  1365.     c := ord(name[i]);
  1366.     PacketData := PacketData + chr((c and $FF00) shr 8) + chr(c and $00FF);
  1367.   end;
  1368.  
  1369.   // null terminated (if not empty, and if needed)
  1370.   if (PacketData <> '') and (Copy(PacketData,Length(PacketData)-1,2) <> #00#00) then
  1371.     PacketData := PacketData + #00#00;
  1372.  
  1373.   Result := inherited GetRaw;
  1374. end;
  1375.  
  1376. procedure TObexName.SetRaw(buffer: String);
  1377. var
  1378.   i: Integer;
  1379. begin
  1380.   inherited SetRaw(buffer);
  1381.  
  1382.   name := '';
  1383.   for i := 0 to round(PacketLen / 2) - 3 do
  1384.     name := name + WideChar((ord(PacketData[(i*2)+1]) shl 8) or ord(PacketData[(i*2)+2]));
  1385. end;
  1386.  
  1387. { TObexLength }
  1388.  
  1389. constructor TObexLength.Create(s: Cardinal);
  1390. begin
  1391.   inherited Create($C3);
  1392.   Size := s;
  1393. end;
  1394.  
  1395. function TObexLength.GetRaw: String;
  1396. begin
  1397.   PacketData := chr((Size and $FF000000) shr 24) + chr((Size and $00FF0000) shr 16) +
  1398.     chr((Size and $0000FF00) shr 8)  + chr(Size and $000000FF);
  1399.  
  1400.   Result := chr(packetID) + PacketData;
  1401. end;
  1402.  
  1403. procedure TObexLength.SetRaw(buffer: String);
  1404. var
  1405.   c: cardinal;
  1406. begin
  1407.   packetID := byte(buffer[1]);
  1408.  
  1409.   c := (cardinal(ord(buffer[2])) shl 24) or (cardinal(ord(buffer[3])) shl 16) or
  1410.     (cardinal(ord(buffer[4])) shl  8) or cardinal(ord(buffer[5]));
  1411.   Size := c;
  1412. end;
  1413.  
  1414. { Global }
  1415.  
  1416. function bytestream2hex(byteStream, seperator: string): String;
  1417. var
  1418.   i: Integer;
  1419. begin
  1420.   Result := '';
  1421.   for i := 1 to length(byteStream) do
  1422.     Result := Result + IntToHex(byte(byteStream[i]),2) + seperator;
  1423. end;
  1424.  
  1425. { TObexItemList }
  1426.  
  1427. destructor TObexItemList.Destroy;
  1428. begin
  1429.   FreeAll;
  1430.   inherited;
  1431. end;
  1432.  
  1433. procedure TObexItemList.FreeAll;
  1434. var
  1435.   index: Integer;
  1436. begin
  1437.   for Index :=0 to Count - 1 do
  1438.     Items[Index].Free;
  1439.   Clear;  
  1440. end;
  1441.  
  1442. function TObexItemList.GetObexItem(Index: integer): TObexItem;
  1443. begin
  1444.   Result:=TObexItem(inherited Items[Index]);
  1445. end;
  1446.  
  1447. procedure TObexItemList.PutObexItem(Index: integer; ObexItem: TObexItem);
  1448. begin
  1449.   inherited Items[Index]:= ObexItem;
  1450. end;
  1451.  
  1452. { TObexConnID }
  1453.  
  1454. constructor TObexConnection.Create(cid: Cardinal);
  1455. begin
  1456.   inherited Create(cid);
  1457.   PacketID := $CB;
  1458. end;
  1459.  
  1460. { TObexDescription }
  1461.  
  1462. constructor TObexDescription.Create(descrStr: WideString);
  1463. begin
  1464.   inherited Create(descrStr);
  1465.   PacketID := $05;
  1466. end;
  1467.  
  1468. { TObexSetPath }
  1469.  
  1470. constructor TObexSetPath.Create(path: String; GoUpFirst,DontCreateDir: boolean);
  1471. begin
  1472.   Constants := 0;
  1473.   if GoUpFirst then Flags := 1 else Flags := 0; // set bit 0
  1474.   if DontCreateDir then Flags := Flags + 2; // set bit 1
  1475.   inherited Create($85);
  1476.   Child.Add(TObexName.Create(path));
  1477. end;
  1478.  
  1479. function TObexSetPath.GetPacketLen: Integer;
  1480. begin
  1481.   Result := inherited GetPacketLen + 2;
  1482. end;
  1483.  
  1484. function TObexSetPath.GetRaw: String;
  1485. var
  1486.   lenHigh, lenLow: Byte;
  1487. begin
  1488.   lenHigh := (PacketLen and $FF00) shr 8;
  1489.   lenLow := PacketLen and $00FF;
  1490.   { Add Flags and Constants }
  1491.   Result := chr(packetID) + chr(lenHigh) + chr(lenLow) + chr(Flags) + chr(Constants) + PacketData;
  1492. end;
  1493.  
  1494. procedure TObexSetPath.SetRaw(buffer: String);
  1495. begin
  1496.   packetID := byte(buffer[1]);
  1497.   Flags := byte(buffer[4]);
  1498.   Constants := byte(buffer[5]);
  1499.   PacketData := copy(buffer, 6, length(buffer) - 5);
  1500. end;
  1501.  
  1502. { TObexByteSeq }
  1503.  
  1504. constructor TObexByteSeq.Create(HID: byte; byteseq: String);
  1505. begin
  1506.   inherited Create(HID);
  1507.   seqbuffer := byteseq;
  1508. end;
  1509.  
  1510. function TObexByteSeq.GetRaw: String;
  1511. begin
  1512.   PacketData := seqbuffer;
  1513.   Result := inherited GetRaw;
  1514. end;
  1515.  
  1516. procedure TObexByteSeq.SetRaw(buffer: String);
  1517. begin
  1518.   inherited SetRaw(buffer);
  1519.   seqbuffer := PacketData;
  1520. end;
  1521.  
  1522. { TObexTarget }
  1523.  
  1524. constructor TObexTarget.Create(targetStr: String);
  1525. begin
  1526.   inherited Create($46,targetStr);
  1527. end;
  1528.  
  1529. { TObexWho }
  1530.  
  1531. constructor TObexWho.Create(whoStr: String);
  1532. begin
  1533.   inherited Create($4A,whoStr);
  1534. end;
  1535.  
  1536. { TObexType }
  1537.  
  1538. constructor TObexType.Create(typeStr: String);
  1539. begin
  1540.   {
  1541.   SyncML 1.1 Specs
  1542.   http://www.openmobilealliance.org/tech/affiliates/syncml/syncmlindex.html
  1543.   
  1544.   MIME header type requirement
  1545.   
  1546.   Data synchronization client implementations conforming to this specification MUST support
  1547.   this header with either the "application/vnd.syncml+xml" or
  1548.   "application/vnd.syncml+wbxml" media type values. Data synchronization server
  1549.   implementations conforming to this specification MUST support both
  1550.   "application/vnd.syncml+xml" and "application/vnd.syncml+wbxml" media
  1551.   type values, as requested by the SyncML data synchronization client.
  1552.  
  1553.   Device Management client implementations conforming to this specification MUST support
  1554.   this header with either the "application/vnd.syncml.dm+xml" or
  1555.   "application/vnd.syncml.dm+wbxml" media type values. Device management
  1556.   server implementations conforming to this specification MUST support both
  1557.   "application/vnd.syncml.dm+xml" and "application/vnd.syncml.dm+wbxml"
  1558.   media type values, as requested by the SyncML device management client.
  1559.   }
  1560.   { Make sure type is null terminated }
  1561.   if (typeStr <> '') and (typeStr[length(typeStr)] <> #0) then
  1562.     typeStr := typeStr + #0;
  1563.   inherited Create($42,typeStr);
  1564. end;
  1565.  
  1566. end.
  1567.  
  1568.